home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tests / help.test < prev    next >
Encoding:
Text File  |  1992-11-07  |  6.4 KB  |  233 lines
  1. #
  2. # help.test
  3. #
  4. # Tests for the help subsystem.  Help must be build first.  If help files
  5. # change, thest tests may have to be changed.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: help.test,v 2.0 1992/10/16 04:49:52 markd Rel $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] != "test"} then {source testlib.tcl}
  21.  
  22. #
  23. # Only run help test if help has been installed.
  24. #
  25. if {"[glob -nocomplain ../tcllib/help/*]" == ""} {
  26.     echo "****"
  27.     echo "**** No help files in tcllib/help - help not available test not run"
  28.     echo "****"
  29.     return
  30. }
  31.  
  32. #------------------------------------------------------------------------------
  33. # Read a line from the server, set an alarm to make sure it doesn't hang.
  34. proc ReadServer {} {
  35.     global G_helpOutPipeFH
  36.  
  37.     alarm 45
  38.     if {[gets $G_helpOutPipeFH line] < 0} {
  39.         alarm 0
  40.         error "EOF from help server"}
  41.     alarm 0
  42.     return $line
  43. }
  44.  
  45. #------------------------------------------------------------------------------
  46. # Eat a prompt line from the help server.
  47.  
  48. proc EatServerPrompt {} {
  49.     set line [ReadServer]
  50.     if {"$line" != "===HELPSERVER==="} {
  51.         error "unexpected output from help server: `$line'"}
  52. }
  53.  
  54. #------------------------------------------------------------------------------
  55. # Send a command to the help server and return the output.  The help server
  56. # output will be bracketed with commands to mark the beginning and ending.
  57. # An extra newline is always queued to continue the help pager.  The prompt of
  58. # the pager will be removed from the output.  This assumes that the output has
  59. # no lines starting with `:'.
  60. #
  61. proc HelpSend {cmd pagerCntVar} {
  62.     global G_helpInPipeFH G_helpOutPipeFH
  63.     upvar $pagerCntVar pagerCnt
  64.  
  65.     puts $G_helpInPipeFH $cmd
  66.     puts $G_helpInPipeFH ""  ;# Just a new line..
  67.     flush $G_helpInPipeFH
  68.  
  69.     set pagerCnt 0
  70.     set results {}
  71.  
  72.     # Read lines of the output.
  73.     while 1 {
  74.         set line [ReadServer]
  75.         if {"[cindex $line 0]" == ":"} {
  76.             set line [crange $line 1 end]
  77.             incr pagerCnt
  78.             puts $G_helpInPipeFH ""  ;# Just a new line
  79.         }
  80.         if {"$line" == "===HELPSERVER==="} {
  81.             break}
  82.         append results $line "\n"
  83.     }
  84.     # Eat the extra prompt caused by the typed-ahead newline
  85.     EatServerPrompt
  86.  
  87.     return $results
  88. }
  89. #
  90. # Create the help server process, which will execute the commands, 
  91. # with stdin and stdout redirected to pipes.
  92. #
  93.  
  94. global G_helpInPipeFH G_helpOutPipeFH G_helpPid
  95.  
  96. pipe fromClientPipeFH G_helpInPipeFH
  97. pipe G_helpOutPipeFH  toClientPipeFH
  98.  
  99. fcntl $G_helpInPipeFH  NOBUF 1
  100. fcntl $G_helpOutPipeFH NOBUF 1
  101.  
  102. flush stdout  ;# Not going to exec, must clean up the buffers.
  103. flush stderr
  104. set G_helpPid [fork]
  105.  
  106. if {$G_helpPid == 0} {
  107.     # Set up stdin/stdout.  Cann't use them nobuf, since we havn't execvp-ed.
  108.     close stdin
  109.     dup $fromClientPipeFH stdin
  110.     close stdout
  111.     dup $toClientPipeFH stdout
  112.     close $G_helpInPipeFH
  113.     close $G_helpOutPipeFH
  114.  
  115.     rename SAVED_UNKNOWN unknown
  116.  
  117.     commandloop {puts stdout "===HELPSERVER==="; flush stdout} \
  118.                 {error "Help server incomplete cmd"}
  119.     error "Help server got eof"
  120. }
  121.  
  122. close $fromClientPipeFH
  123. close $toClientPipeFH
  124.  
  125. #
  126. # An alarm will be set when talking to the server uncase it doesn't talk back
  127. #
  128. signal error SIGALRM
  129.  
  130. # Nuke the first prompt
  131. EatServerPrompt
  132.  
  133. # Now run the tests.
  134.  
  135.  
  136. Test help-1.1 {help tests} {
  137.     HelpSend "help" promptCnt
  138. } 0 {
  139. Subjects available in /:
  140.    control/         debug/           files/           filescan/
  141.    internation/     intro/           keyedlists/      libraries/
  142.    lists/           math/            processes/       signals/
  143.    status/          strings/         tclshell/        time/
  144.    variables/       
  145.  
  146. Help files available in /:
  147.    Tcl.brf          TclX.brf         help             
  148. }
  149.  
  150. Test help-1.2 {help tests} {
  151.     HelpSend "helppwd" promptCnt
  152. } 0 {Current help subject directory: /
  153. }
  154.  
  155. Test help-1.3 {help tests} {
  156.     HelpSend "helpcd intro" promptCnt
  157. } 0 {}
  158.  
  159. Test help-1.4 {help tests} {
  160.     HelpSend "helppwd" promptCnt
  161. } 0 {Current help subject directory: /intro
  162. }
  163.  
  164. Test help-1.5 {help tests} {
  165.     set result [HelpSend "help comments" promptCnt]
  166.     set fh [open "../tcllib/help/intro/comments"]
  167.     set expect [read $fh]
  168.     close $fh
  169.     set summary {}
  170.     if {"$expect" == "$result"} {
  171.         append summary "CORRECT"
  172.     } else {
  173.         append summary "DATA DOES NOT MATCH"
  174.     }
  175.     if {$promptCnt == 0} {
  176.        append summary " : PROMPT OK"
  177.     } else {
  178.        append summary " : TOO MANY PROMPTS"
  179.     }
  180.     set summary
  181. } 0 {CORRECT : PROMPT OK}
  182.  
  183. Test help-1.6 {help tests} {
  184.     set result [HelpSend "help expressions" promptCnt]
  185.     set fh [open "../tcllib/help/intro/expressions"]
  186.     set expect [read $fh]
  187.     close $fh
  188.     set summary {}
  189.     if {"$expect" == "$result"} {
  190.         append summary "CORRECT"
  191.     } else {
  192.         append summary "DATA DOES NOT MATCH"
  193.     }
  194.     if {$promptCnt >= 2} {
  195.        append summary " : PROMPT OK"
  196.     } else {
  197.        append summary " : NOT ENOUGH PROMPTS"
  198.     }
  199.     set summary
  200. } 0 {CORRECT : PROMPT OK}
  201.  
  202. Test help-1.7 {help tests} {
  203.     HelpSend "apropos upvar" promptCnt
  204. } 0 {variables/upvar - Bind a variable to another variable up the procedure call stack.
  205. }
  206.  
  207. Test help-1.8 {help tests} {
  208.     HelpSend "apropos clock" promptCnt
  209. } 0 {time/alarm - Set a process alarm clock.
  210. time/convertclock - Parse and convert a date and time string to integer clock value.
  211. time/fmtclock - Convert an integer time value to human-readable format.
  212. time/getclock - Return current date and time as an integer value.
  213. }
  214.  
  215. Test help-1.9 {help tests} {
  216.     HelpSend "helpcd" promptCnt
  217. } 0 {}
  218.  
  219. Test help-1.10 {help tests} {
  220.     HelpSend "helppwd" promptCnt
  221. } 0 {Current help subject directory: /
  222. }
  223.  
  224.  
  225. # Terminate the help server.
  226.  
  227. puts $G_helpInPipeFH "exit 0"
  228. set status [wait $G_helpPid]
  229. if {"$status" != "$G_helpPid EXIT 0"} {
  230.     error "Bad status returned: `$status'"}
  231.  
  232. return
  233.